home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TBUTIL2.LZH / SIDEWYTR.PAS < prev    next >
Pascal/Delphi Source File  |  1984-08-28  |  6KB  |  182 lines
  1. PROGRAM sideways(INPUT,OUTPUT,infile);
  2.  
  3. {COPYRIGHT @ 1983
  4.       Jim Holtman
  5.       35 Dogwood Trail
  6.       Randolph, NJ 07869
  7.       (201) 361-3396}
  8.  
  9. { Modified for Turbo Pascal by Jeff Firestone.  August, 1984. }
  10.  
  11. {This program will print the `infile' sideways on an EPSON MX-80 Printer.
  12.  It makes use of the characters in the PC's ROM for the graphics mode of
  13.  the CRT. The characters in the file are `looked up' and then the graphics
  14.  mode of the printer is used for output.}
  15.  
  16. { The DEBUG statements will output on the CRT the current line being printed.
  17.   The line will appear vertically. }
  18.  
  19. TYPE
  20.     CHAR_PER_LINE = 0..1999;   { Maximum input line size }
  21.     vstr          = ARRAY[0..1999] OF CHAR;
  22.     ROM_ARRAY     = ARRAY[0..32000] OF CHAR;
  23.     Strng         = STRING[20];
  24.  
  25. CONST
  26.     EOFL              = #26;  { TEXT EOF character }
  27.     EOL               = #13;
  28.     TAB               = #9;   { expand TABs }
  29.     MAX_LINES         = 48;   { Lines/Page }
  30.     MAX_LINES1        = 49;   { MAXLINES + 1 }
  31.     SPACES_PER_LINE   = 2;    { 2/72th inch space between lines }
  32.     SPACES_PER_LETTER = 8;    { DOT size of characters }
  33.  
  34. VAR
  35.     lptr       : ARRAY[1..MAX_LINES] OF ^vstr; { input lines }
  36.     inbuf      : ARRAY[CHAR_PER_LINE] OF CHAR;
  37.     linesize   : CHAR_PER_LINE;
  38.     indx       : 0..MAX_LINES;
  39.     line       : 0..MAX_LINES1;
  40.     infile     : FILE OF CHAR;
  41.     printer    : TEXT;
  42.     col        : CHAR_PER_LINE;
  43.     pchar      : INTEGER;
  44.     ichar      : 0..7;
  45.     max        : CHAR_PER_LINE;
  46.     rom        : ^ROM_ARRAY;
  47.     inchar     : CHAR;
  48.     name       : Strng;
  49.     ignore     : SET OF #0..#$FF;
  50.  
  51.  
  52.  
  53. {--- 1 --------------------------------------------------------------}
  54.  
  55. PROCEDURE Greetings;
  56. BEGIN
  57.   GOTOXY(26,1);
  58.   WRITELN('SIDEWAYS FOR TURBO PASCAL');
  59.   WRITELN; WRITELN;
  60.   WRITELN('SideWays prints the file you specify sidewise on you Epson printer.');
  61.   WRITELN('This program is useful for printing spreadsheet PRINT files which are');
  62.   WRITELN('too wide to be printed in the normal manner.');
  63. END;
  64.  
  65.  
  66. {--- 2 --------------------------------------------------------------}
  67.  
  68. PROCEDURE PRINT_CHAR(pchar : INTEGER);
  69. BEGIN
  70.   pchar := pchar * 8;
  71.   FOR ichar := 7 DOWNTO 0 DO  {Pickup character, a line at a time, }
  72.       WRITE(printer,rom^[pchar+ichar]); {from ROM}
  73.   FOR ichar := 1 TO SPACES_PER_LINE DO
  74.       WRITE(printer, #0);
  75. END;
  76.  
  77.  
  78. {--- 1 --------------------------------------------------------------}
  79.  
  80. PROCEDURE SEND_TO_PRINTER;
  81. BEGIN
  82.   WRITELN(OUTPUT,'line=',line,' max=',max);  {--DEBUG--}
  83.   IF inchar <> EOFL THEN
  84.     line := MAX_LINES
  85.   ELSE line := line-1;
  86.   FOR col := 1 TO max DO
  87.   BEGIN  { Output collected lines }
  88.     WRITE(printer,#27 + 'A' + CHR(SPACES_PER_LETTER) + #27 + 'K',
  89.     CHR((line*(8+SPACES_PER_LINE)) MOD 256),
  90.     CHR((line*(8+SPACES_PER_LINE)) DIV 256));
  91.     FOR indx := line DOWNTO 1 DO
  92.     BEGIN  { Scan next column }
  93. {if column pointer is larger than string, output BLANK}
  94.         IF col > ORD(lptr[indx]^[0]) THEN
  95.           pchar := ORD(' ')
  96.         ELSE
  97.           pchar := ORD(lptr[indx]^[col]);
  98.         WRITE(OUTPUT,CHR(pchar));  {--DEBUG--}
  99.         PRINT_CHAR(pchar);
  100.     END;  {  FOR indx := line DOWNTO 1 DO  }
  101.     WRITELN(printer);
  102.     WRITELN(OUTPUT);{--DEBUG--}
  103.   END;   { FOR col := 1 TO max DO }
  104.   WRITELN(printer);
  105.   WRITELN(OUTPUT);{--DEBUG--}
  106.   FOR indx := 1 TO line DO DISPOSE(lptr[indx]);  {Free up space on HEAP}
  107.   WRITE(printer, #12);
  108. END;
  109.  
  110.  
  111. {--- 1 --------------------------------------------------------------}
  112.  
  113. PROCEDURE READ_IN_THE_FILE;
  114. LABEL break;
  115. BEGIN
  116.   IF inchar = EOL THEN
  117.   BEGIN   {check for End-of-Line}
  118.       inbuf[0]:= CHR(LO(linesize));
  119.       inbuf[1]:= CHR(HI(linesize));
  120.       GetMem(lptr[line], linesize+1);      { allocate string storage }
  121.       MOVE(inbuf[0], lptr[line]^, (linesize+1)); { save }
  122.       IF linesize > max THEN max := linesize;
  123.       linesize := 1;
  124.       line := line+1;
  125.       READ(infile, inchar);
  126.       WRITELN(OUTPUT,'<<');   {--DEBUG--}
  127.       GOTO break;
  128.   END;
  129.   IF inchar = EOFL THEN GOTO break;
  130.  
  131.   IF NOT(inchar IN IGNORE) THEN
  132.   BEGIN
  133.     IF inchar = TAB THEN
  134.       REPEAT  {Expand TABs}
  135.            linesize := linesize+1;
  136.            inbuf[linesize] := ' ';
  137.       UNTIL (linesize MOD 8) = 0
  138.     ELSE BEGIN
  139.            linesize := linesize+1;
  140.            inbuf[linesize] := inchar;
  141.     END;  { ELSE }
  142.     WRITE(OUTPUT,inchar);{--DEBUG--}
  143.   END;  { IF NOT(inchar IN IGNORE) }
  144.  
  145.   READ(infile, inchar);
  146. break:
  147. END;
  148.  
  149.  
  150. {--------------------------------------------------------------------}
  151.  
  152. BEGIN
  153.   IGNORE:= [#0..#8,#10..#$1f,#$80..#$FF];
  154.   {NOTE!!!!
  155.      The following declarations define the segment and offset values
  156.      for the characters in the PC version of the ROM. For the XT, check
  157.      the TECH MANUAL for the correct values.}
  158.  
  159.   MEMW[SEG(rom):OFS(rom)+2]:= $F000; {seg addr of the CRT char generation}
  160.   MEMW[SEG(rom):OFS(rom)]  := $FA6E; {OFS address  of matrix in the ROM --
  161.                                                    for non-XT versions of PC}
  162.  
  163.   Greetings; Writeln; Writeln;
  164.   WRITE('What file would you like to print SideWays : ');
  165.   READLN(name);
  166.   ASSIGN(printer,'lpt1:');    { Open the printer }
  167.   ASSIGN(infile,name);
  168.   REWRITE(printer);
  169.   RESET(infile);
  170.   READ(infile, inchar);
  171.   REPEAT
  172.       max      := 0;
  173.       linesize := 1;
  174.       line     := 1;
  175.  
  176.       WHILE (line <= MAX_LINES) AND (inchar <> EOFL) DO
  177.          READ_IN_THE_FILE;
  178.       SEND_TO_PRINTER;
  179.  
  180.   UNTIL inchar = EOFL;
  181. END.
  182.